COMMENT ⊗   VALID 00009 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE FATAL
C00005 00003	PRINT BACKTRACE
C00009 00004	WHAT USER CAN DO ABOUT ERROR
C00011 00005	WE GET HERE ON AT INTERRUPT
C00014 00006	HERE WE TAKE CARE OF THE UGLY OVERFLOW MESS!
C00019 00007	SUBROUTINES (WHICH USE PP INSTEAD OF P)
C00022 00008	DATA STORAGE
C00023 00009	HERE LIE THE ROUTINES TO PUSH AND POP ACCUMULATORS (STOLEN FROM MONITER)
C00025 ENDMK
C⊗;
TITLE FATAL

	INTERNAL FATAL.,WARN.,TRAPINIT,PUSHIT,POPIT,DDTGO,OVRGAG
	EXTERNAL PDL

	EXTERNAL JOBCNI,JOBAPR,JOBTPC,JOBREL,JOBHRL,JOBDDT
	EXTERNAL JOBREN,JOBOPC,JOBSA

IFNDEF JENFIX < JENFIX←←0 >	;SET TO -1 WHEN INTJEN IS FIXED

	OPDEF INTJEN [ 723B8 ]
	OPDEF GO     [ JRST ]
	OPDEF JRSTF  [ JRST 2,]

	CNT←14
	RA←15
	PP←16
	P←17
	INTTTI←←4000000		; INTERRUPT ON <ESC>I
	CNS←←400000		; INTERRUPT ON CONS TRAP
	POV←←200000		; INTERRHUPT ON PDL OV
	ILM←←20000		; INTERRUPT ON ILL. MEM. REF.
	NXM←←10000		; INTERRUPT ON NON-EX. MEM.
	INTFOV←←100		; INTERRUPT ON FOATING OVERFLOW
	INTOV←←10		; INTERRUPT ON ARITHMETIC ROVERFHLOW

	OVBOTH←←INTOV+INTFOV
	DEFINE INTFOR <FOR @` I ⊂ (INTTTI,POV,ILM,OVBOTH)>

;INITIALIZE APR TRAP
TRAPINIT: MOVEI 0,INTLOC
	  MOVEM 0,JOBAPR
IFN JENFIX
<	  POP P,INTPC
	  INTJEN INTWRD
>
IFE JENFIX
<	  MOVE 0,INTWRD
	  INTENB 0,
	  POPJ P,
>

	XWD 777000,[SIXBIT/WARN./]
WARN.:	SETZM NOCONT
	GO FATAL2
	XWD 777000,[SIXBIT/FATAL./]
FATAL.:	SETOM NOCONT
	SETZM ALWAYS
FATAL2:	SETOM ILOCK		;INTERLOCK AGAINST INTERRUPT
IFNDEF ERRUUO
<	POP P,INTPC
>
	MOVEM 0,ACSAVE		;SAVE STATE OF WORLD
	MOVE 0,[XWD 1,ACSAVE+1]
	BLT ACSAVE+17
	SKIPE NOCONT
	OUTSTR [ASCIZ/FATAL:  /]
	SKIPN NOCONT
	OUTSTR [ASCIZ/WARNING:  /]
IFDEF ERRUUO
<	MOVE 0,40
	OUTSTR @0
	MOVE 0,ERRUU.
	MOVEM 0,INTPC
>
IFNDEF ERRUUO
<	MOVE 0,@1(P)
	OUTSTR @0
>
	MOVEM 0,ERRTXT
	SETZ 0,
	INTENB			;TURN OFF OUR ENABLINGS
	SETZM ILOCK		;RESET INTERLOCK, WE'RE SAFE NOW
	MOVE PP,[IOWD 10,BKPDL]	;GET A TEMPERARY PDL
	GO BTRACE
;PRINT BACKTRACE
;
; The following sneaky routine looks down the pushdown list for something that
; looks like a PC word and prints out its name if it has an NSUBR header, otherwise
; it prints its adress in octal.  It finds out what routine was called by looking 
; one or more back of the return address on the PDL.  Needless to say, it can be
; fooled by routines that skip return or push funny PC words on the stack.
;
	USERMODE←←1B5		;ALWAYS ON IN A PC
	PC.OFF←←1B4+1B6+37B17	;ALWAYS OFF IN A PC
				;1B4 is byte interrupt, never in user PDL
				;1B6 is IOT mode, almost never on in PDL

BTRACE:	HRRZ P,P		;GET READY TO PRINT A BACKTRACE
	OUTSTR[ASCIZ/
BACKTRACE: /]
PCLOOP:	MOVE RA,(P)		;PICK UP WORD OFF OF STACK AND SEE IF IT'S A PC
	TLNE RA,(USERMODE)	;IS USER MODE ON?
	TLNE RA,(PC.OFF)	;AND OTHER DETERMI1NING BITS OFF?
	GO NOTPC		;NO, NOT A PC
	PUSH PP,RA		;LEFT HALF GOOD, NOW, IS IT IN OUR CORE IMAGE
	PUSHJ PP,ADRCHK
	GO NOTPC		;NO, PROBABLY NOT A PC
	MOVEI CNT,3		;DON'T LOOK MORE THAN THREE BACK
	OUTSTR[ASCIZ/ /]
PJLOOP:	SUBI RA,1
	HLRZ 0,(RA)		;LOOK FOR A PUSHJ
	CAIN 0,(<PUSHJ P,>)
	JRST GOTPJ
	SOJG CNT,PJLOOP
UNKNPJ:	OUTSTR[ASCIZ/(?)/]	;WE DIDN'T FIND A PUSHJ, INDICATE AN UNKNOWN ROUTINE
	JRST NOTPC		;AND LOOK FOR MORE

GOTPJ:	PUSH PP,(RA)		;WE FOUND A PUSHJ P,
	PUSHJ PP,ADRCHK		;CHECK ADDRESS
	JRST UNKNPJ		;OOPS, PRINT BARF MESSAGE
	LDB 0,[POINT 12,-1(1),11]	;LOOK BACK AT SUBROUTINE-1
	CAIE 0,7770			;IS SPECIAL MARK THERE?
	GO [ LDB 0,[POINT 12,-1(1),11]	;NO, TRY BACK ANOTHER, IN CASE IT STARTS
	     CAIN 0,7770		;AT SUBROUTINE+1
	     GO [ MOVE 1,-2(1)		;SPECIAL MARK THERE
		  PUSH PP,(1)		;PRINT NAME+1
		  PUSHJ PP,SIXOUT
		  OUTSTR[ASCIZ/+1/]
		  GO NOTPC ]
	     PUSH PP,1		;PRINT OCTAL OF SUBROUTINE ADDRESS
	     PUSHJ PP,OCTOUT
	     GO NOTPC ]
	MOVE 1,-1(1)		;PRINT NAME OF ROUTINE
	PUSH PP,(1)
	PUSHJ PP,SIXOUT
NOTPC:	SOS P			;NOW, LETS TRY NEXT ONE DOWN
	CAIL P,PDL		;END YET?
	JRST PCLOOP		;NO
	OUTSTR[ASCIZ/
/]				;YES, CRLF
	MOVSI 17,ACSAVE		;RESTORE ACS
	BLT 17,16
	SKIPE STAT6
	SKIPN OVRGAG
	GO CMLOOP		;WE COULD FALL THRU BUT THIS IS SAFER
	OUTSTR[ASCIZ/(By the way, the PDP-6 is down.)
/]↔	SETZM STAT6
	GO CMLOOP
;WHAT USER CAN DO ABOUT ERROR
;
CMLOOP:	SKIPN NOCONT
	GO [ SKIPE ALWAYS
	     GO CONT
	     OUTSTR [ASCIZ/→/]
	     GO CMLOO2]
	OUTSTR [ASCIZ/?/]
CMLOO2:	CLRBFI			;NO TYPE AHEAD, THANK YOU
	INCHRW 17		;WHAT DOES USER WANT TO DO
	ANDI 17,137
	CAIN 17,"R"
	JRST @JOBREN
	CAIN 17,"S"
	JRST [ HRRZ 17,JOBSA↔JRST (17) ]
	CAIN 17,"D"
	JRST DDTCALL
	CAIN 17,"α"
	JRST CONT
	SKIPE NOCONT
	JRST NOTCOM
	CAIN 17,12
	CAIE 17,15
	JRST [	CAIN 17,12
		SETOM ALWAYS
	CONT:	SETZM ILOCK
		JRST INTRT2 ]
NOTCOM:	OUTSTR[ASCIZ/???
D - DDT, R - REENTER, S - START/]
	SKIP NOCONT
	OUTSTR[ASCIZ/, <RETURN> CONTINUE
/]↔	OUTSTR[ASCIZ/
/]↔	OUTSTR @ERRTXT
	GO CMLOOP

;SEE IT DDT IS LOADED AND RUN IT
DDTCALL:SKIPN 17,JOBDDT
	JRST [ OUTSTR[ASCIZ/
NO DDT.
?/]↔	       GO CMLOOP ]
IFE JENFIX
<	SETOM ILOCK		;WATCH THE RACE CONDITION
	MOVE 17,INTPC
	MOVEM 17,JOBOPC
	OUTSTR[ASCIZ/
YOU'RE IN DDT.
/]
	MOVE 17,INTWRD
	INTENB 17,
	MOVE 17,ACSAVE+17
	SETZM ILOCK		;WATCH THE RACE CONDITION
	JRST @JOBDDT
>
	OUTSTR [ASCIZ/
YOU'RE IN DDT.
/]
IFN JENFIX
<	MOVE 17,ACSAVE+17
	INTJEN INTWRD
>
;WE GET HERE ON AT INTERRUPT
;
INTLOC:	SETZ		;TURN OFF INTERRUPTS, JUST IN CASE!
	INTENB
	MOVEM 5,STAT6	;REMEMBER THE STATUS OF PDP-6
	MOVE 0,JOBCNI		;HOW DID WE GET HERE?
	INTFOR
<IFE I∧777777 < TLNE 0,(I)
>IFN I∧777777 < TRNE 0,I
>	JRST [ MOVEI .`I
	       JRST USRRET ]
>
	MOVEI .UNKNOWN
USRRET:	MOVEM PCGO
	SKIPE ILOCK
	GO ILOSE
	UWAIT		;WHEN WE RETURN, WE'LL GET OUR AC'S BACK
	MOVEM 0,ACSAVE
	MOVE 0,JOBTPC
	MOVEM 0,INTPC
	MOVE 0,[XWD 1,ACSAVE+1]
	BLT 0,ACSAVE+17
	DEBREAK
	MOVE PP,[IOWD 10,BKPDL]
	JRSTF @PCGO

.POV:	OUTSTR[ASCIZ/?
PDL OV/]
	SOS INTPC		;INSTRUCTION WHERE IT REALLY HAPPENED
	PUSHJ PP,ATUSER
	GO IFATAL

.ILM:	PUSH PP,INTPC
	PUSHJ PP,ADRCHK
	GO [ OUTSTR[ASCIZ/?
PC OUT OF BOUNDS/]
	     GO .ILM2 ]
;*** A PAGING ROUTINE COULD BE INCLUDED HERE ***
	OUTSTR[ASCIZ/?
ILL MEM REF/]
.ILM2:	PUSHJ PP,ATUSER
	GO IFATAL

.INTTT:	OUTSTR[ASCIZ/
<ESC> I  INTERRUPT/]
	PUSHJ PP,ATUSER
	SETZM NOCONT
	SETZM ALWAYS
	GO BTRACE

.UNKNO:	OUTSTR[ASCIZ/?
UNEXPECTED INTERRUPT/]
	PUSHJ PP,ATUSER
	GO IFATAL

IFATAL:	SETOM NOCONT
	SETZM ALWAYS
	GO BTRACE

ILOSE:	CAIN .INTTTI
	JRST [ MOVE 0,INTWRD	;WE'RE ALREADY IN AN ERROR ROUTINE
	       INTENB 0,
	       DISMIS ]
	MOVE 0,JOBTPC
	MOVEM 0,INTPC
	UWAIT		;GET BACK USER ACS, ETC.
	DEBREAK		;GET BACK TO USER LEVEL
	OUTSTR[ASCIZ/?
INTERRUPT OCCURED DURING ERROR ROUTINE!  /]
	HALT .+1
	JRSTF @INTPC
;HERE WE TAKE CARE OF THE UGLY OVERFLOW MESS!
;
.OVBOTH:MOVE 0,INTPC
	TLNE 0,000040		;TEST ZERO DIVIDE
	GO [ SKIPN OVRGAG	;DIVISION BY ZERO RESULTS IN INFINITY!
	     OUTSTR[ASCIZ/DIVISION BY ZERO/]
	     MOVE 0,[377777777777]
	     GO FIXOVER ]
	TLNE 0,000100		;TEST FLOATING UNDERFLOW
 	GO [ SKIPN OVRGAG	;SET TO ZERO
	     OUTSTR[ASCIZ/FLOATING UNDERFLOW/]
	     SETZ 0,
	     GO FIXOVER ]
	TLNE 0,040000
	JRST [	SKIPN OVRGAG
		OUTSTR[ASCIZ/FLOATING OVERFLOW/]
		MOVE 0,[377777777777]	;FLOATING OVERFLOW PRODUCES INFINITY
		GO FIXOVER ]
	TLNN 0,400000		;INTEGER OVERFLOW?
	HALT .+1
	MOVSI 1,400000
	ANDCAM 1,INTPC
	JRST INTRET
FIXOVER:MOVEM 0,OVFIX
	SKIPN OVRGAG
	PUSHJ PP,ATUSER
	MOVSI 1,440140		;TURN OFF LOSING BITS
	ANDCAB 1,INTPC
	MOVE 1,-1(1)		;IT HAPPENED AT PC-1
XCLOOP:	LDB 2,[POINT 9,1,8]		;GET OPCODE
	CAIN 2,<XCT>/1B8		;IS IT AN XCT INSTRUCTION
	JRST [ TLZ 1,777400		;TURN OFF OPCODE
	       TLO 1,(<MOVE 1,>)
	       MOVEM 1,OVINST
	       MOVSI 17,ACSAVE		;YES, TRY NEXT ONE IN CHAIN
	       BLT 17,16
	       MOVE 17,ACSAVE+17
	       XCT OVINST
	       JRST XCLOOP ]
	MOVEM 1,OVINST
	TLZ 1,777740		;TURN IT INTO A MOVEI TO CALCULATE EFFECTIVE ADDRESS
	TLO 1,(<MOVEI 2,>)
	MOVEM 1,OVOP
	MOVSI 17,ACSAVE		;GET ACS FOR EFFECTIVE ADDRESS CALCULATION
	BLT 17,16
	MOVE 17,ACSAVE+17
	XCT OVOP		;DO ADDRESS CALCULATION, PUTTING RESULT INTO AC.2
	CAIGE 2,17		;IN CASE THE EFFECTIVE ADDRESS IN AN AC
	ADDI 2,ACSAVE		;POINT TO SAVED ACS
	LDB 3,[POINT 4,OVINST,12];GET AC FIELD INTO AC.3
	ADDI 3,ACSAVE		;POINT TO SAVED ACS
	LDB 1,[POINT 9,OVINST,8];GET OPCODE
	MOVE 0,OVFIX	
	CAIN 1,<FSC>/1B8	;SPECIAL TEST FOR FSC
	JRST [ SETZ 1,		;RESULT INTO AC.0
	       GO NTEST2 ]
	CAILE 1,140		;IS IT FLOATING IMMEDIATE?
	CAILE 1,177
	JRST NTEST		;NO, NOT FLOATING
	ANDI 1,7
	CAIE 1,5		;ONLY IF LOWER ORDER DIGIT=5
	JRST NTEST
	MOVSS 2,2
	SKIPGE 2
	MOVN 0,0
	JRST NTEST2
NTEST:	ANDI 1,3		;JUST MODE BITS, PLEASE
	CAIN 1,1		;DON'T TRY TO REFERENCE MEMORY ON IMMEDIATE, PLEASE
	JRST NTEST2
	SKIPGE (2)		;CHANGE SIGN AS IF (MEMORY)<0
	MOVN 0,0
NTEST2:	SKIPGE (3)		;CHANGE SIGN IF (AC)<0
	MOVN 0,0
	SKIPN (3)		;MAKE 0/0=0
	SETZ 0,
	ANDI 1,3		;JUST MODE BITS, PLEASE
	TRNE 1,2		;DOES RESULT GO TO MEMORY?
	MOVEM 0,(2)		;YES
	CAIE 1,2		;JUST TO MEMORY?
	MOVEM 0,(3)		;NO
INTRET:	MOVSI 17,ACSAVE
	BLT 17,16
INTRT2:
IFN JENFIX
<	MOVE 17,ACSAVE+17
	INTJEN INTWRD
>
IFE JENFIX
<	MOVE 17,INTWRD
	INTENB 17,
	MOVE 17,ACSAVE+17
	JRSTF @INTPC
>
;SUBROUTINES (WHICH USE PP INSTEAD OF P)
;____________________________________________________________________
; Routine to check to make sure RH is in core image.  Returns RH is 1
; and skips if legal address
ADRCHK:	HRRZ 1,-1(PP)
	CAMLE 1,JOBREL
	GO [ CAIL 1,400000	;(DON'T NEGLECT UPPER!)
	     CAILE 1,JOBHRL
	     JRST POPP1J
	     GO .+1]
	AOS (PP)
POPP1J:	SUB PP,[XWD 2,2]
	JRST @2(PP)
;____________________________________________________________________
; Print a right half in octal	(if called at OCTOUT+1, print left half)
OCTOUT:	MOVSS -1(PP)			;MOVE INTO LEFT HALF
	SKIPA 4,[[ ROTC 3↔"0" ]]	;WE CAN SHARE CODE WITH SIXOUT
; Print a number in sixbit
SIXOUT:	MOVEI 4,[ ROTC 6↔" "]	;(TO SHARE WITH OCTOUT)
	MOVEI 3,6		;NUMBER OF CHARACTERS
	MOVE 1,-1(PP)		;GET ARG.
SXLOOP:	SETZ 0,			;CLEAR AC WERE ABOUT TO ROTC INTO
	XCT (4)			;GET HIGH ORDER DIGIT/CHARACTER
	ADD 0,1(4)		;ADD APPROPRIATE THING
	OUTCHR 0		;OUTPUT
	CAIE 0," "		;TEST FOR END (FOR SIXBIT, THIS NEVER HAPPENS FOR OCTOUT)
	SOJG 3,SXLOOP		;MORE TO COME
	SUB PP,[XWD 2,2]	;WE'RE DONE, RETURN
	JRSTF @2(PP)
;____________________________________________________________________
;PRINT ' AT USER 000000'
ATUSER:	PUSH PP,0		;SAVE AC 0
	OUTSTR [ASCIZ/ AT USER /]
	PUSH PP,INTPC
	PUSHJ PP,OCTOUT
	OUTSTR [ASCIZ/
/]
	POP PP,0
	POPJ PP,
;DATA STORAGE
ACSAVE:	BLOCK 20
BKPDL:	BLOCK 10

;INTWRD AND INTPC MUST BE IN ORDER OR INTJEN WILL LOSE!
	.INTWRD←←0
	INTFOR <.INTWRD←←.INTWRD!I
>
INTWRD:	.INTWRD
INTPC:	BLOCK 1

PCGO:	BLOCK 1

ILOCK:	BLOCK 1
STAT6:	BLOCK 1

OVFIX:	BLOCK 1
OVOP:	BLOCK 1
OVINST:	BLOCK 1

NOCONT:	BLOCK 1
ALWAYS:	BLOCK 1
OVRGAG: BLOCK 1
ERRTXT:	BLOCK 1
;;HERE LIE THE ROUTINES TO PUSH AND POP ACCUMULATORS (STOLEN FROM MONITER)

IFNDEF PUSHIT <
↑↑PUSHIT:
	PUSH P,0	; SAVE 0
	HLRE 0,P	; PICK UP COUNT
	ADDI 0,20	; ADD IN DISPLACEMENT
	XOR 0,P		; IF SIGNS ARE DIFFERENT, NOT ENOUGH STACK
	JUMPGE 0,PUSHOK
	POP P,0		; CAN'T DO IT, LOSE BIG
	OUTSTR [ASCIZ ⊗NOT ENOUGH ROOM TO PUSH ACS!!
⊗]
	SKIPN JOBDDT
	JRST [ OUTSTR[ASCIZ⊗YOU LOSE.	⊗]
	       HALT PUSHIT ]
↑↑DDTGO:OUTSTR[ASCIZ⊗YOU'RE IN DDT
⊗]
	POP P,JOBOPC
	JRST @JOBDDT
PUSHOK:	POP P,0		; GET BACK 0
	EXCH 0,(P)	;SAVE 0 AND GET RETURN.
	MOVEM 0,20(P)	;GEE, THIS WAY WE RETURN WITH A POPJ
	MOVEI 0,1(P)
	HRLI 0,1
	BLT 0,17(P)
	ADD P,[XWD 20,20]
	POPJ P,		;RETURN TO SENDER

↑↑POPIT:
	MOVSI 0,-17(P)
	HRRI 0,1
	BLT 0,17
	MOVE 0,20(P)
	EXCH 0,(P)
	POPJ P,
>
	END